#' Set/Get Tushare Pro API token
#'
#' @param token a character vector
#' @param save save set token to token_file
#' @param token_file path to token_file
#'
#' @return token itself, invisibly.
#' @export
ts_set_token <- function(token, save = TRUE, token_file = "~/tk.csv") {

  mdtxr.global$tstk <- as.character(token)
  if (save)
  {
    csv <- list(token = token)
    data.table::fwrite(data.table::setDT(csv), path.expand(token_file))
  }

  invisible(mdtxr.global$tstk)
}

#' @rdname ts_set_token
#' @export
ts_get_token <- function(token_file = "~/tk.csv") {

  if (is.null(mdtxr.global$tstk)) {
    token_file <- path.expand(token_file)
    if (file.exists(token_file))
    {
      token <- data.table::fread(token_file)
      mdtxr.global$tstk <- token$token[1]
    }
    else
    {
      mdtxr.global$tstk <- ""
    }
  }
  mdtxr.global$tstk
}

#' Make raw request to Tushare Pro API
#'
#' @param api_name name of API function, please refer to online document for more information.
#' @param ... passed to API function.
#' @param fields data fields to request
#' @param token API token.
#' @param timeout timeout in seconds for httr request.
#'
#' @return data.table
ts_request <- function(api_name, ..., fields = c(""), token = ts_get_token(), timeout = 5.0) {

  api_url <- "http://api.waditu.com"

  req_body <- list(
    token    = as.character(token),
    api_name = api_name,
    params   = list(...),
    fields   = fields
  )

  req <- httr::POST(url = api_url,
                    config = httr::timeout(timeout),
                    body = req_body,
                    encode = "json")
  res <- httr::content(req,
                       as = "parsed",
                       type = "application/json",
                       encoding = "UTF-8")

  if (is.null(res$data)) {
    stop(res$msg, call. = FALSE)
  }

  suppressWarnings({
    if (length(res$data$items)) {
      dt <- tryCatch({
        data.table::rbindlist(res$data$items)
      }, error = function(e) {
        #error happens when null ROW is passed by fromJSON()
        null_row <- sapply(res$data$items, is.null)
        na_row <- sapply(res$data$items, is.na)
        ignore_row <- null_row | na_row
        data.table::rbindlist(res$data$items[!ignore_row])
      })
    } else {
      #create an empty data.table
      dt <- do.call(data.table::data.table,
                    rep_len(x = list(logical()), length.out = length(res$data$fields)))
    }
  })
  data.table::setnames(dt, unlist(res$data$fields))

  dt
}

#' Get a Tushare API object.
#'
#' @param api_token API token.
#' @param time_mode data type for time objects
#' @param date_mode data type for date objects
#' @param logi_mode data type for logical objects
#' @param tz Default timezone of POSIXct data
#'
#' @return a tsapi object.
#' @export
#'
tsapi <- function(api_token = ts_get_token(),
                  time_mode = c("POSIXct", "ITime", "char"),
                  date_mode = c("Date", "POSIXct", "IDate", "char"),
                  logi_mode = c("logical", "char"),
                  tz = "Asia/Shanghai") {

  time_mode <- match.arg(time_mode)
  date_mode <- match.arg(date_mode)
  logi_mode <- match.arg(logi_mode)

  return(
    structure(as.character(api_token),
              time_mode = time_mode,
              date_mode = date_mode,
              logi_mode = logi_mode,
              tz        = tz,
              class     = "tsapi")
  )
}

#' Print Values
#'
#' @param x A tsapi object
#' @param ... not used
#'
#' @return x, invisibly
#' @export
#'
'print.tsapi' <- function(x, ...) {
  cat(as.character(x))
}

#' Request data from Tushare API
#'
#' @param x A tsapi object
#' @param func Tushare API function to call
#'
#' @return a data.table
#' @export
#'
'$.tsapi' <- function(x, func) {

  force(x)
  force(func)
  f <- function(..., timeout = 5.0) {

    arg <- list(...)

    #fix date/time/logical arguments
    argn <- names(arg)

    #datetime
    idx <- stringr::str_detect(argn, "date$|time$|^period$")
    if (any(idx)) {
      arg[idx] <- lapply(arg[idx], dttm_to_tschar, tz = get_tz(x))
    }
    #logical
    for (i in seq_along(arg)) {
      if (is.logical(arg[[i]])) {
        arg[[i]] <- ifelse(arg[[i]], "1", "0")
      }
    }

    #extra arguments passed to TusRequest()
    arg$api_name <- func
    arg$token    <- x
    arg$timeout  <- timeout

    dt <- do.call(ts_request, arg)

    #parse dt
    if (nrow(dt)) {
      parse_date <- date_parser(x)
      parse_dttm <- dttm_parser(x)
      parse_logi <- logi_parser(x)

      cols <- colnames(dt)
      #parse date columns
      col_date <- which(stringr::str_detect(cols, "date$|^period$"))
      if (length(col_date)) {
        dt[, (col_date) := lapply(.SD, parse_date), .SDcol = col_date]
      }
      #parse datetime columns
      col_time <- which(stringr::str_detect(cols, "time$"))
      if (length(col_time)) {
        dt[, (col_time) := lapply(.SD, parse_dttm), .SDcol = col_time]
      }
      #parse logical columns
      col_logi <- which(stringr::str_detect(cols, "^is_|_flag$"))
      if (length(col_logi)) {
        dt[, (col_logi) := lapply(.SD, parse_logi), .SDcol = col_logi]
      }
      #in case of all NA, data.table parses the column as logical column, convert to numeric
      col_na <- which(sapply(dt, FUN = function(col) all(is.na(col))))
      if (length(col_na))
      {
        dt[, (col_na) := lapply(.SD, as.numeric), .SDcol = col_na]
      }

      #set keys
      keys <- NULL
      dttm_idx <- c(col_time, col_date)
      if ("ts_code" %in% cols) {
        keys <- "ts_code"
      }
      if (length(dttm_idx)) {
        keys <- c(keys, cols[dttm_idx[1]])
      }
      if (length(keys)) {
        data.table::setkeyv(dt, keys)
      }

      #fix update_flag issue for fundamental data
      if (all(c("update_flag", "ts_code", "end_date") %in% cols)) {
        data.table::setkeyv(dt, c("ts_code", "end_date", "update_flag"))
        dt <- dt[, lapply(.SD, data.table::last), by = c("ts_code", "end_date")]
      }
    }

    dt
  }

  f
}
